home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Night Owl 6
/
Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso
/
037a
/
wedits22.zip
/
WEINIT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-08-15
|
10KB
|
402 lines
UNIT WEInit; {$O+}
{ -- This is the Initialization Module for WWIVEdit 2.2
-- Last Modified 8/15/91
-- Written By:
-- Adam Caldwell
--
-- This Code is limited Public Domain (see WWIVEDIT.PAS for details
--
-- Known Errors: None
--
-- Planned Enhancements: None
-- }
{$R-,V-,S+,B-,E-,N-} { These Optomize things as much as possible }
INTERFACE
PROCEDURE Initialize;
PROCEDURE InitInfo;
PROCEDURE FindTitle(VAR Title,Destination:string);
IMPLEMENTATION
USES DOS,WEVars, WEString, WELine, WEKbd, WEOutput;
VAR
x : integer;
LastLine:integer;
sr:searchrec;
s,st: string;
ch, rs, re : char;
FUNCTION StripChar(VAR s:string):char;
VAR s1:string;
BEGIN
IF s[1]='#' THEN BEGIN
delete(s,1,1);
s1:='';
WHILE (s<>'') AND (s[1] IN ['0'..'9']) DO
BEGIN
s1:=s1+s[1];
delete(s,1,1);
END;
StripChar:=chr(value(s1));
END ELSE BEGIN
StripChar:=s[1];
delete(s,1,1);
END;
END;
PROCEDURE Initialize;
BEGIN
UserNum:=0;
ParameterFileName:='CHAIN.TXT';
translate:=LeftS(GetEnv('BBS'),4)<>'WWIV';
InDos := Translate;
{$V-}
Fsplit(ParamStr(0),StartupDir,st,st);
{$V+}
FillChar(info,SizeOf(Info),0);
Info.Tagline[1] := '';
Info.Tagline[2] := '';
info.Tagline[3] := '';
IgnoreName:=False;
assign(InfoFile,StartupDir+'TAGLINES.CMN');
AllowTitleChange:=False;
CurrentColor:='0';
AfterNext:=DoNothing;
BeforeNext:=DoNothing;
BlockStart:=0;
BlockEnd:=0;
LineLen:=79;
SearchString:=#1#2#3#4;
SearchOps:='';
FileName:=ParamStr(1);
LineLen:=value(ParamStr(2));
IF LineLen>79 THEN LineLen:=79;
IF LineLen=0 THEN LineLen:=79;
ScreenHeight:=value(ParamStr(3));
IF (screenHeight<30) AND (ScreenHeight>25) THEN ScreenHeight:=25;
IF ScreenHeight=0 THEN ScreenHeight:=ScreenSize DIV 160;
MaxLines:=value(ParamStr(4));
IF MaxLines>AbsoluteMaxLines THEN MaxLines:=AbsoluteMaxLines-1;
IF MaxLines>250 Then MaxLines:=AbsoluteMaxLines-1;
IF MaxLines=0 THEN MaxLines:=AbsoluteMaxLines-1;
Local:=False;
OkTagLines := False;
AddBBSTag:=False;
AddSL:=30;
ColorRangeCheck := FALSE;
MCICommands:=FALSE;
KeyBIOS:=FALSE;
NoColor:=FALSE;
ForceAnsi:=FALSE;
FOR ch:=#0 TO #255 DO
IF ch IN ['0'..'7'] THEN CMap[ch]:=TRUE ELSE CMap[ch]:=FALSE;
FOR x:=1 TO ParamCount DO
BEGIN
s:=TransformString(ParamStr(x));
NoColor:=NoColor OR (cmpLeft(s,'/NOCOLOR'));
ForceAnsi:=ForceAnsi OR (cmpLeft(s,'/ANSI'));
Local:=Local OR cmpLeft(s,'/L');
OkTagLines:=OkTagLines OR cmpLeft(s,'/T');
AddBBSTag:=AddBBSTag OR cmpLeft(s,'/A');
MCICommands:=MCICommands OR cmpLeft(s,'/MCI');
KeyBIOS:=KeyBIOS OR cmpLeft(s,'/K');
IF cmpLeft(s,'/D:') THEN BEGIN
st:=Paramstr(x);
delete(st,1,3);
st:='#'+st;
AddSL:=ord(stripchar(st));
END;
IF cmpLeft(s,'/C:') THEN BEGIN
st:=ParamStr(x);
delete(st,1,3);
WHILE st<>'' DO
BEGIN
rs:=StripChar(st);
IF st[1]='-' THEN BEGIN
delete(st,1,1);
re:=StripChar(st)
END
ELSE
re:=rs;
FOR ch:=rs TO re DO
Cmap[ch]:=TRUE;
IF (st<>'') AND (st[1]=',') THEN
delete(st,1,1);
END;
END
ELSE ColorRangeCheck := ColorRangeCheck OR cmpLeft(s,'/C');
END;
OkTagLines := NOT OkTagLines; { By default, taglines are on. /T turns them off }
AddBBSTag := NOT AddBBSTag; { Default Tagline is on }
ColorRangeCheck := NOT ColorRangeCheck; { default Range check is on }
KeyBIOS:=NOT KeyBIOS; { Default is use the BIOS }
IF NOT ColorRangeCheck THEN
FOR ch:=#0 TO #255 DO
Cmap[ch]:=TRUE;
IF Not Local THEN Local:=GetEnv('BBS')='';
IF Local THEN MaxLines:=AbsoluteMaxLines-1;
cx:=1; cy:=1;
WindowTop := 5; ViewTop := cy;
WindowBottom := ScreenHeight-4;
WindowHeight := WindowBottom-WindowTop;
ViewBottom := ViewTop + WindowHeight;
new(Line[0]);
InitLine(Line[0]^);
LastLine:=0;
FOR x:=1 TO MaxLines+1 DO
IF MaxAvail> 2*sizeof(Linetype) THEN
BEGIN
new(Line[x]);
Line[x]^:=Line[0]^;
END
ELSE IF LastLine=0 THEN LastLine:=x-1;
IF LastLine>0 THEN MaxLines:=LastLine;
FOR x:=1 TO MaxPhyLines DO
initline(screen[x]);
InsertMode:=True;
findfirst(StartupDir+'WWIVEDIT.KEY',0,sr); { Check if file exists }
OkLocalMacros:=DosError=0;
findfirst(StartupDir+'MACROS.LCL',0,sr); { Check if file exists }
OkLocalMacros:=OkLocalMacros AND (dosError=0);
assign(transtable,StartupDir+'WWIVEDIT.KEY');
findfirst(StartupDir+'BBS*.TAG',0,sr); { check if file exists }
AddBBSTag:=AddBBSTag AND (dosError=0);
FindFirst(FileName,0,sr);
FileThere:=DosError=0;
IF CmpLeftI(Filename,'BBS') AND
(RightS(TransformString(FileName),4)='.TAG') THEN
FileThere:=TRUE;
ScreenState:=0;
END; { Initialize }
PROCEDURE iport;
VAR
f : text;
i : string;
s : string;
n : integer;
BEGIN
IF InDos THEN
BEGIN
UserNum:=1;
thisuser.name:='';
thisuser.realname:='';
thisuser.sl:=255;
incom:=FALSE;
Local:=True;
TrueKeyboard:=True;
END
ELSE
BEGIN
assign(f,ParameterFileName);
{$I-} reset(f); {$I+}
IF IOResult<>0 THEN BEGIN
assign(f,StartupDir+ParameterFileName);
{$I-} reset(f); {$I+}
END;
IF IOResult = 0 THEN BEGIN
Drain;
readln(f,usernum);
readln(f,thisuser.name);
readln(f,thisuser.realname);
readln(f);
readln(f);
readln(f);
readln(f);
Drain;
readln(f);
readln(f);
readln(f);
readln(f,thisuser.sl);
readln(f);
readln(f);
readln(f);
readln(f,n);
incom := (n = 1);
Drain;
close(f);
END
ELSE BEGIN
writeln('Could not find CHAIN.TXT.');
halt;
END;
END;
END;
PROCEDURE InitInfo;
VAR
i :integer;
BEGIN
Randomize;
IF UserNum=0 THEN
BEGIN
IPort;
IF InCom AND Local THEN BEGIN
UserNum:=1;
ThisUser.sl:=255;
ThisUser.Name:='';
IgnoreName:=true;
END;
END;
{$I-} reset(InfoFile); {$I+}
IF IOResult<>0 THEN rewrite(InfoFile);
seek(InfoFile,usernum);
{$I-} read(InfoFile,Info); {$I+}
IF ((IOResult<>0) OR (ThisUser.RealName<>Info.UserName)) AND (NOT IgnoreName) THEN BEGIN
IF FileSize(InfoFile)<userNum THEN
BEGIN
fillchar(info,sizeof(inforec),0);
info.UserName:='No Name';
seek(InfoFile,FileSize(InfoFile));
FOR i:=FileSize(InfoFile) TO usernum-1 DO
write(InfoFile,Info);
END;
seek(InfoFile,usernum);
info.UserName:=ThisUser.RealName;
write(InfoFile,Info);
END;
Drain;
close(InfoFile);
i:=0;
IF info.method=6 THEN
info.method:=info.selected;
IF info.method=4 THEN
REPEAT
inc(info.selected);
IF info.selected>3 THEN info.selected:=1;
inc(i);
UNTIL (i>3) OR (info.tagline[info.selected]<>'')
ELSE WITH info DO
IF (method=5) AND ((Tagline[1]<>'') OR (Tagline[2]<>'') OR (Tagline[3]<>'')) THEN
REPEAT
selected:=random(3)+1;
UNTIL Tagline[selected]<>'';
END;
TYPE
Buffer = ARRAY[1..25] OF String[80];
VAR
b:buffer;
PROCEDURE StripEndC(VAR s:string; ch:char);
VAR
i:integer;
BEGIN
i:=length(s);
WHILE (i>1) AND (s[i]<>ch) DO
dec(i);
Delete(s,i,length(s)-i+1);
END;
PROCEDURE FindTitle(VAR Title,Destination:string);
VAR
i:integer;
t:text;
D: DirStr;
N: NameStr;
E: ExtStr;
BEGIN
IF NOT InDos THEN
BEGIN
assign(t,'EDITOR.INF');
{$I-} reset(t); {$I+}
IF IOResult<>0 THEN
BEGIN
Title:='';
Destination:='';
FOR i:=1 TO 25 DO
b[i]:='';
{$V-}
FOR i:=1 TO WhereY-1 DO
BEGIN
Drain;
ReadScreen(B[i],1,wherey-i);
StripEndString(B[i]);
END;
{$V+}
FOR i:=25 DOWNTO 1 DO
BEGIN
IF CmpLeft(b[i],'Title') THEN title:=b[i];
IF cmpLeft(b[i],'E-mail') OR
cmpLeft(b[i],'Post') OR
cmpLeft(b[i],'Multi') OR
cmpLeft(b[i],'File') OR
cmpLeft(b[i],'[') OR
cmpLeft(b[i],'<')
THEN
Destination:=b[i];
END;
IF cmpLeft(Destination,'<') THEN
BEGIN
StripEndC(Destination,'>');
Delete(destination,1,1);
Destination:='E-mailing '+Destination; { cheap trick }
END;
IF title='' THEN Title:=b[1];
IF cmpLeft(title,'Title') THEN delete(title,1,7);
IF cmpLeft(Destination,'E-mail') THEN delete(Destination,1,10)
ELSE IF cmpLeft(Destination,'Multi') THEN Destination:='Multi-Mail'
ELSE IF cmpLeft(Destination,'Post') THEN
BEGIN
delete(Destination,1,8);
StripEndC(Destination,'?');
END
ELSE IF cmpLeft(Destination,'File') THEN
BEGIN
delete(Destination,1,10);
Title:='Text File';
END
ELSE IF cmpLeft(Destination,'[') THEN
BEGIN
StripEndC(Destination,']');
delete(Destination,1,1);
i:=pos('[',Destination);
IF i>0 THEN delete(Destination,1,i);
END
ELSE Destination:='Message Base';
END
ELSE BEGIN
Drain;
readln(t,title);
readln(t,Destination);
readln(t,usernum);
readln(t,thisuser.name);
readln(t,thisuser.realname);
readln(t,thisuser.sl);
Drain;
close(t);
AllowTitleChange:=True;
END;
END ELSE
BEGIN
FSplit(TransformString(ParamStr(1)),D,N,E);
Title:=N+E;
IF D='' THEN
getdir(0,d);
Destination:=d;
IF Title='' THEN BEGIN
writeln('Error! Need a Filename to startup.');
halt;
END;
END;
END;
END.